Show code
library(GeoPressureR)
library(leaflet)
library(leaflet.extras)
library(raster)
library(dplyr)
library(ggplot2)
library(kableExtra)
library(plotly)
library(GeoLocTools)
setupGeolocation()
knitr::opts_chunk$set(echo = FALSE)
load(paste0("../data/1_pressure/", params$gdl_id, "_pressure_prob.Rdata"))
load(paste0("../data/2_light/", params$gdl_id, "_light_prob.Rdata"))
load(paste0("../data/3_static/", params$gdl_id, "_static_prob.Rdata"))
load(paste0("../data/4_basic_graph/", params$gdl_id, "_basic_graph.Rdata"))
Settings used
Show code
kable(gpr)
| gdl_id | crop_start | crop_end | thr_dur | extent_N | extent_W | extent_S | extent_E | map_scale | map_max_sample | map_margin | prob_map_s | prob_map_thr | shift_k | calib_lon | calib_lat | calib_1_start | calib_1_end | calib_2_start | calib_2_end | calib_2_lon | calib_2_lat | prob_light_w | thr_prob_percentile | thr_gs | Column3 | RingNo | scientific_name | common_name | mass | wing_span | Color |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 18LX | 2017-06-20 | 2018-05-02 | 12 | 50 | -16 | 0 | 23 | 5 | 300 | 30 | 1 | 0.9 | 0 | 17.05 | 48.9 | 2017-06-20 | 2017-08-05 | NA | NA | NA | NA | 0.1 | 0.9 | 120 | NA | NA | NA | Great Reed Warbler | NA | NA | NA |
Pressure timeserie
Show code
pressure_na <- pam$pressure %>%
mutate(obs = ifelse(isoutliar | sta_id == 0, NA, obs))
p <- ggplot() +
geom_line(data = pam$pressure, aes(x = date, y = obs), colour = "grey") +
geom_point(data = subset(pam$pressure, isoutliar), aes(x = date, y = obs), colour = "black") +
# geom_line(data = pressure_na, aes(x = date, y = obs, color = factor(sta_id)), size = 0.5) +
geom_line(data = do.call("rbind", shortest_path_timeserie) %>% filter(sta_id > 0), aes(x = date, y = pressure0, col = factor(sta_id))) +
theme_bw() +
scale_colour_manual(values = col) +
scale_y_continuous(name = "Pressure(hPa)")
ggplotly(p, dynamicTicks = T) %>% layout(showlegend = F)
Light
Show code
raw_geolight <- pam$light %>%
transmute(
Date = date,
Light = obs
)
lightImage(tagdata = raw_geolight, offset = 0)
tsimagePoints(twl$twilight,
offset = 0, pch = 16, cex = 1.2,
col = ifelse(twl$deleted, "grey20", ifelse(twl$rise, "firebrick", "cornflowerblue"))
)
abline(v = gpr$calib_2_start, lty = 1, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_1_start, lty = 1, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_2_end, lty = 2, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_1_end, lty = 2, col = "firebrick", lwd = 1.5)
Show code
li_s <- list()
l <- leaflet(width = "100%") %>%
addProviderTiles(providers$Stamen.TerrainBackground) %>%
addFullscreenControl()
for (i_r in seq_len(length(light_prob))) {
i_s <- metadata(light_prob[[i_r]])$sta_id
info <- pam$sta[pam$sta$sta_id == i_s, ]
info_str <- paste0(i_s, " | ", info$start, "->", info$end)
li_s <- append(li_s, info_str)
l <- l %>% addRasterImage(light_prob[[i_r]], opacity = 0.8, colors = "OrRd", group = info_str)
}
l %>%
addCircles(lng = gpr$calib_lon, lat = gpr$calib_lat, color = "black", opacity = 1) %>%
addLayersControl(
overlayGroups = li_s,
options = layersControlOptions(collapsed = FALSE)
) %>%
hideGroup(tail(li_s, length(li_s) - 1))
GeoPressureViz
To visualize the path on GeoPressureViz, you will need to also load the pressure and light probability map and align them first with the code below.
Show code
sta_marginal <- unlist(lapply(static_prob_marginal, function(x) raster::metadata(x)$sta_id))
sta_pres <- unlist(lapply(pressure_prob, function(x) raster::metadata(x)$sta_id))
sta_light <- unlist(lapply(light_prob, function(x) raster::metadata(x)$sta_id))
pressure_prob <- pressure_prob[sta_pres %in% sta_marginal]
light_prob <- light_prob[sta_light %in% sta_marginal]
The code below will open with the shortest path computed with the graph approach. You can change it to
Show code
geopressureviz <- list(
pam_data = pam,
static_prob = static_prob,
static_prob_marginal = static_prob_marginal,
pressure_prob = pressure_prob,
light_prob = light_prob,
pressure_timeserie = shortest_path_timeserie
)
save(geopressureviz, file = "~/geopressureviz.RData")
shiny::runApp(system.file("geopressureviz", package = "GeoPressureR"),
launch.browser = getOption("browser")
)
Stationay period information
| start | end | sta_id |
|---|---|---|
| 2017-06-20 00:00:00 | 2017-08-04 19:50:00 | 1 |
| 2017-08-04 23:15:00 | 2017-08-05 19:30:00 | 2 |
| 2017-08-06 02:50:00 | 2017-08-06 19:15:00 | 3 |
| 2017-08-07 03:10:00 | 2017-08-07 19:15:00 | 4 |
| 2017-08-08 00:10:00 | 2017-08-29 18:40:00 | 5 |
| 2017-08-30 04:30:00 | 2017-08-30 18:45:00 | 6 |
| 2017-08-31 04:10:00 | 2017-08-31 18:35:00 | 7 |
| 2017-09-01 09:00:00 | 2017-09-01 19:00:00 | 8 |
| 2017-09-02 09:00:00 | 2017-09-04 20:05:00 | 9 |
| 2017-09-05 04:35:00 | 2017-09-06 19:40:00 | 10 |
| 2017-09-07 04:35:00 | 2017-09-09 20:00:00 | 11 |
| 2017-09-10 01:15:00 | 2017-09-10 19:35:00 | 12 |
| 2017-09-11 02:45:00 | 2017-09-11 23:30:00 | 13 |
| 2017-09-12 00:20:00 | 2017-09-15 20:55:00 | 14 |
| 2017-09-16 04:30:00 | 2017-09-16 20:50:00 | 15 |
| 2017-09-17 01:55:00 | 2017-09-18 19:55:00 | 16 |
| 2017-09-18 23:40:00 | 2017-09-19 23:35:00 | 17 |
| 2017-09-20 01:05:00 | 2017-12-05 18:55:00 | 18 |
| 2017-12-06 05:35:00 | 2017-12-06 19:15:00 | 19 |
| 2017-12-07 00:10:00 | 2018-04-10 19:45:00 | 20 |
| 2018-04-11 00:00:00 | 2018-04-11 19:10:00 | 21 |
| 2018-04-12 05:50:00 | 2018-04-12 19:10:00 | 22 |
| 2018-04-13 05:40:00 | 2018-04-13 19:15:00 | 23 |
| 2018-04-14 05:30:00 | 2018-04-14 18:40:00 | 24 |
| 2018-04-15 15:00:00 | 2018-04-15 18:50:00 | 25 |
| 2018-04-15 22:00:00 | 2018-04-25 18:45:00 | 26 |
| 2018-04-26 02:40:00 | 2018-04-29 21:20:00 | 27 |
| 2018-04-30 03:05:00 | 2018-04-30 18:40:00 | 28 |
| 2018-05-01 01:10:00 | 2018-05-01 23:30:00 | 29 |